home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / psion / go.z / go / go.opl < prev    next >
Text File  |  1993-07-29  |  14KB  |  837 lines
  1. REM GO EDITOR using John Hind's application framework
  2. REM Copyright (C) 1993 John Tromp
  3.  
  4. APP Go
  5.     TYPE 3
  6.     PATH "\GO"
  7.     EXT "GO"
  8.     ICON "\GO\Go.ico"
  9. ENDA
  10.  
  11. PROC Go:
  12.     GLOBAL bw%,bh%,bs%    REM board width,height,size
  13.     GLOBAL gb%                    REM go board, stone bitmap
  14.     GLOBAL eb%,db%            REM empty/dot bitmaps
  15.     GLOBAL sr%,sd%,nd%    REM stone radius/diameter, neighbour distance
  16.     GLOBAL bwp%,bhp%        REM board width/height in pixels
  17.     GLOBAL maxnv%                REM max # non-visible pixels
  18.     GLOBAL mv%(512),mn% REM moves, move number
  19.     GLOBAL bd%(880)            REM board data sets
  20.     GLOBAL cx%,cy%            REM cursor x/y
  21.     GLOBAL pt%(440)            REM point type
  22.     GLOBAL uf%(440)            REM union find
  23.     GLOBAL log%(4096)        REM union/find log
  24.     GLOBAL clix%                REM log index
  25.     GLOBAL ogb%,osb%        REM overview go board/stones
  26.     GLOBAL obwp%,obhp%    REM overview board width/height
  27.     GLOBAL komi                    REM 2nd move compensation
  28.     GLOBAL name$(128)        REM file name
  29.     GLOBAL changed%            REM remember to save
  30.     GLOBAL ten%                    REM prepare for rank>=10
  31.     GLOBAL ko%(512)            REM forbidden moves
  32.     LOCAL x%,y%
  33.  
  34.     db%=gCREATEBIT(4,4)
  35.     gCLS
  36.     gAT 1,1 :gLINEBY 1,0
  37.     osb%=gCREATEBIT(15,5)
  38.     gCLS :gAT 2,2 :gLINEBY 1,0
  39.     gAT 5,0 :gINVERT 5,5
  40.     gAT 10,0 :gINVERT 5,5
  41.     gAT 11,1 :gFILL 3,3,1
  42.     komi=5.5
  43.     log%(1)=0
  44.     x%=22 :y%=22
  45.     pt%(x%)=3
  46.     pt%(x%-21)=-1 :pt%(y%-1)=-1
  47.     DO
  48.         x%=x%+1 :y%=y%+21
  49.         pt%(x%-21)=-1 :pt%(y%-1)=-1
  50.         pt%(x%)=4 :pt%(y%)=6
  51.     UNTIL x%=41
  52.     sr%=3 :maxnv%=15
  53.     bw%=9 :bh%=9
  54.     newstns:
  55.     
  56.  LOADM "\OPO\FRAMELIB.OPO"            REM Load the Application Framework code
  57.  fAutoOff:                                            REM Allow automatic switch-off
  58.  fRun:($330,"LSBEPNDTOKRCX",0)    REM Run application
  59. ENDP
  60.  
  61. PROC aHkX%:        REM Callback to exit application on PSION-X
  62.  RETURN 100        REM "Exit from application" message
  63. ENDP
  64.  
  65. PROC aMh5%:        REM Callback for "Printable key pressed" message
  66.     IF fParm%=32
  67.         forward%:
  68.         RETURN 0
  69.     ENDIF
  70.     IF fParm%=49 AND bh%>=10
  71.         torow:(ten%+1)
  72.         ten%=10-ten%
  73.     ELSEIF fParm% >= 48 AND fParm% < 58
  74.         torow:(ten%+fParm%-48)
  75.         ten%=0
  76.     ELSE
  77.         fParm%=fParm% AND $FFDF
  78.         IF fParm%>=%A AND fParm%<=%T
  79.             tocol:(fParm%-%A-(fParm%<%J))
  80.             ten%=0
  81.         ELSE
  82.             BEEP 2,300
  83.         ENDIF
  84.     ENDIF
  85.     RETURN 0
  86. ENDP
  87.  
  88. PROC aMh6%:        REM Callback for "Special key pressed" message
  89.     IF fParm%=$100 :up:
  90.     ELSEIF fParm%=$101 :down:
  91.     ELSEIF fParm%=$102 :right:
  92.     ELSEIF fParm%=$103 :left:
  93.     ELSEIF fParm%=8  :back:
  94.     ELSEIF fParm%=13 :move:
  95.     ELSE BEEP 2,300
  96.     ENDIF
  97.     RETURN 0
  98. ENDP
  99.  
  100. PROC aMh9%:        REM Callback for "Menu key pressed" message
  101.     LOCAL k%
  102.  
  103.     mINIT
  104.     mCARD "File","Load",%L,"Save as",%S
  105.     mCARD "Play","Begin",%B,"End",%E,"Pass",%P,"Notate",%N
  106.     mCARD "Display","Dimensions",%D,"Scrolling",%T,"Overview",%O
  107.     mCARD "Special","Komi",%K,"Remove",%R,"Count",%C,"Exit",%x
  108.     k%=fMenu%:                          REM Show menu (NOTE: bug fixed version of MENU)
  109.     IF k%=0                REM Menu aborted by user
  110.         RETURN 0        REM Return null command
  111.     ELSE
  112.         fParm%=k%        REM Parameter for "Hotkey pressed" message
  113.         RETURN 4        REM "Hotkey pressed" message
  114.     ENDIF
  115. ENDP
  116.  
  117. PROC aMh10%:        REM Callback for "Help key pressed" message
  118.     dINIT "Help: Go Editor"
  119.     dTEXT "","Use cursor keys to move"
  120.     dTEXT "","or type the coordinates"
  121.     dTEXT "","Shift increases cursor movement"
  122.     dTEXT "","Enter to place stone"
  123.     dTEXT "","Delete/Space to go back/forward"
  124.     fLock:
  125.     DIALOG
  126.     fUnlock:
  127.     RETURN 0
  128. ENDP
  129.  
  130. PROC aHkN%:
  131.     GIPRINT CHR$(cx%+%A+(cx%<10))+GEN$(bh%+1-cy%,2)
  132.     RETURN 0
  133. ENDP
  134.  
  135. PROC aHkK%:
  136.     dINIT "Set komi"
  137.     dFLOAT komi,"Komi:",0,256
  138.     fLock:
  139.     DIALOG
  140.     fUnlock:
  141.     RETURN 0
  142. ENDP REM setkomi
  143.  
  144. PROC aHkC%:
  145.     LOCAL p%,s%,ws
  146.     GLOBAL wc%,bc%
  147.     GIPRINT "Counting..."
  148.     p%=pos%:(bw%,bh%)
  149.     DO
  150.         s%=bd%(p%)
  151.         IF s%=0 :s%=4 :ENDIF
  152.         bd%(p%+440)=s%
  153.         p%=p%-1
  154.     UNTIL p%<21
  155.     p%=pos%:(bw%,bh%)
  156.     DO
  157.         DO
  158.             s%=bd%(p%+440)
  159.             IF s%=4
  160.                 s%=whose%:(p%)
  161.                 IF s%=1 OR s%=2
  162.                     assign:(p%,s%)
  163.                 ENDIF
  164.             ENDIF
  165.             IF s%=1
  166.                 bc%=bc%+1
  167.             ELSEIF s%=2
  168.                 wc%=wc%+1
  169.             ENDIF
  170.             p%=p%-1
  171.         UNTIL pt%(p%)=-1
  172.         p%=p%+bw%-20
  173.     UNTIL p%<21
  174.     overvw:(440)
  175.     ws=wc%+komi
  176.     dINIT "Score"
  177.     dTEXT "White:",GEN$(ws,5)
  178.     dTEXT "Black:",GEN$(bc%,5)
  179.     IF ws>bc%
  180.         dTEXT "","White wins"
  181.     ELSEIF bc%>ws
  182.         dTEXT "","Black wins"
  183.     ELSE dTEXT "","Jigo"
  184.     ENDIF
  185.     fLock:
  186.     DIALOG
  187.     fUnlock:
  188.     RETURN 0
  189. ENDP REM count
  190.  
  191. PROC torow:(r%)
  192.     IF r%>=1 AND r%<=bh%
  193.         cy%=bh%+1-r%
  194.         mvcur:
  195.     ENDIF
  196. ENDP
  197.  
  198. PROC tocol:(c%)
  199.     IF c%>=1 AND c%<=bw%
  200.         cx%=c%
  201.         mvcur:
  202.     ENDIF
  203. ENDP
  204.  
  205. PROC whose%:(p%)
  206.     LOCAL s%
  207.     IF pt%(p%)=-1 :RETURN 0 :ENDIF
  208.     s%=bd%(p%+440)
  209.     IF s%<4 :RETURN s% :ENDIF
  210.     bd%(p%+440)=0
  211.     RETURN whose%:(p%-21) OR whose%:(p%+1) OR whose%:(p%+21) OR whose%:(p%-1)
  212. ENDP REM whose
  213.  
  214. PROC assign:(p%,s%)
  215.     IF pt%(p%)=-1 OR bd%(p%+440) :RETURN :ENDIF
  216.     bd%(p%+440)=s%
  217.     assign:(p%-21,s%)
  218.     assign:(p%+1,s%)
  219.     assign:(p%+21,s%)
  220.     assign:(p%-1,s%)
  221. ENDP REM assign
  222.  
  223. PROC aHkL%:
  224.     LOCAL ret%
  225.     name$="\GO\*.go"
  226.     dINIT "Load file"
  227.     dFILE name$,"File:",0
  228.     fLock:
  229.     ret%=DIALOG
  230.     fUnlock:
  231.     IF ret%=0 :RETURN 0 :ENDIF
  232.     fParm$=name$
  233.     RETURN 102
  234. ENDP
  235.  
  236. PROC aOpen%:        REM Callback for file opening
  237.     LOCAL ret%,fh%,x%,y%
  238.  
  239.     name$=fParm$
  240.     ret%=IOOPEN(fh%,name$,0)
  241.     IF ret%<0
  242.         GIPRINT ERR$(ret%)
  243.         RETURN -3
  244.     ENDIF
  245.     ret%=IOREAD(fh%,ADDR(mv%()),2)
  246.     x%=PEEKB(ADDR(mv%()))
  247.     y%=PEEKB(ADDR(mv%())+1)
  248.     IF x%<2 OR x%>19 OR y%<2 OR y%>19
  249.         GIPRINT "Illegal board size"
  250.         IOCLOSE(fh%)
  251.         RETURN -3
  252.     ENDIF
  253.     resize:(x%,y%)
  254.     ret%=IOREAD(fh%,ADDR(mv%()),1024)
  255.     IF ret%=-36
  256.         ret%=0 :REM premature eof (bug)
  257.     ENDIF
  258.     GIPRINT GEN$(ret%/2,3)+" moves read"
  259.     IOCLOSE(fh%)
  260.     changed%=0
  261.     RETURN 0
  262. ENDP
  263.  
  264. PROC aCreate%:        REM Callback for file creation
  265.  name$=fParm$
  266.  changed%=1
  267.  aHkD%:
  268.  RETURN 0
  269. ENDP
  270.  
  271. PROC aClose%:        REM Calback for file closing
  272.     LOCAL ret%
  273.  
  274.     IF changed%
  275.         fLock:
  276.         ret%=ALERT("Save changes?","","No","Yes")
  277.         fUnlock:
  278.         IF ret%=2
  279.              aHkS%:
  280.         ENDIF
  281.     ENDIF
  282.     RETURN 0
  283. ENDP
  284.  
  285. PROC aHkS%:
  286.     LOCAL bytes%,m%,i&,fh%
  287.     m%=0
  288.     WHILE mv%(m%+1) :m%=m%+1 :ENDWH
  289.     i&=mn%
  290.     dINIT "Save file"
  291.     dFILE name$,"Name:",17
  292.     dLONG i&,"Moves:",0,m%
  293.     fLock:
  294.     m%=DIALOG
  295.     fUnlock:
  296.     IF m%=0
  297.         GIPRINT "Not saved"
  298.         RETURN 0
  299.     ENDIF
  300.     IF UPPER$(RIGHT$(name$,3))<>".GO"
  301.         name$=name$+".go"
  302.     ENDIF
  303.     m%=IOOPEN(fh%,name$,$102)
  304.     IF m%<0
  305.         GIPRINT ERR$(m%)
  306.         RETURN -1
  307.     ENDIF
  308.     bytes%=256*bh%+bw%
  309.     IOWRITE(fh%,ADDR(bytes%),2)
  310.     bytes%=2*i&
  311.     m%=IOWRITE(fh%,ADDR(mv%()),bytes%)
  312.     IF m%<0
  313.         GIPRINT ERR$(m%)
  314.         RETURN -1
  315.     ENDIF
  316.     GIPRINT "Game saved"
  317.     changed%=0
  318.     IOCLOSE(fh%)
  319.     RETURN 0
  320. ENDP REM save
  321.  
  322. PROC aHkO%:
  323.     overvw:(0)
  324.     RETURN 0
  325. ENDP
  326.  
  327. PROC overvw:(off%)
  328.     LOCAL dx%,y%,p%,s%
  329.     gUSE ogb%
  330.     gCLS
  331.     y%=1
  332.     DO
  333.         dx%=0 :gAT 0,4*(y%-1)
  334.         p%=pos%:(1,y%)
  335.         DO
  336.             s%=5*bd%(p%+dx%+off%)
  337.             gCOPY osb%,s%,0,5,5,0
  338.             dx%=dx%+1 :gMOVE 4,0
  339.         UNTIL dx%=bw%
  340.     y%=y%+1
  341.     UNTIL y%>bh%
  342.     gUSE gb%
  343. ENDP REM overvw
  344.  
  345. PROC aHkB%:
  346.     emptybrd:(0)
  347.     drawbrd:
  348.     RETURN 0
  349. ENDP REM start
  350.  
  351. PROC emptybrd:(off%)
  352.     LOCAL i%
  353.     i%=1
  354.     DO
  355.         bd%(i%+off%)=0
  356.         i%=i%+1
  357.     UNTIL i%>440
  358.     clix%=1 :mn%=0
  359. ENDP REM emptybrd
  360.  
  361. PROC up:
  362.     IF cy%>1
  363.         IF fKmod% AND 2
  364.             cy%=MAX(cy%-6,1)
  365.         ELSE
  366.             cy%=cy%-1
  367.         ENDIF
  368.         mvcur:
  369.     ENDIF
  370. ENDP REM up
  371.  
  372. PROC down:
  373.     IF cy%<bh%
  374.         IF fKmod% AND 2
  375.             cy%=MIN(cy%+6,bh%)
  376.         ELSE
  377.             cy%=cy%+1
  378.         ENDIF
  379.         mvcur:
  380.     ENDIF
  381. ENDP REM down
  382.  
  383. PROC right:
  384.     IF cx%<bw%
  385.         IF fKmod% AND 2
  386.             cx%=MIN(cx%+6,bw%)
  387.             curret:
  388.         ELSE
  389.             cx%=cx%+1
  390.             gMOVE nd%,0
  391.         ENDIF
  392.     ENDIF
  393. ENDP REM right
  394.  
  395. PROC left:
  396.     IF cx%>1
  397.         IF fKmod% AND 2
  398.             cx%=MAX(cx%-6,1)
  399.             curret:
  400.         ELSE
  401.             cx%=cx%-1
  402.             gMOVE -nd%,0
  403.         ENDIF
  404.     ENDIF
  405. ENDP REM left
  406.  
  407. PROC move:
  408.     GLOBAL root%
  409.     LOCAL p%,s%,ret%,cap%
  410.     p%=pos%:(cx%,cy%)
  411.     IF bd%(p%) OR p%=ko%(mn%+1)
  412.         BEEP 9,100
  413.         RETURN
  414.     ENDIF
  415.     IF fParm%=13
  416.         changed%=1
  417.     ENDIF
  418.     mn%=mn%+1
  419.     s%=2-(mn% AND 1)
  420.     play:(cx%,cy%,s%)
  421.     root%=p% :ufset:(root%,0)
  422.     ko%(mn%+1)=0
  423.     cap%=neighbr%:(p%-21,cx%,cy%-1,s%)+2*neighbr%:(p%+1,cx%+1,cy%,s%)+4*neighbr%:(p%+21,cx%,cy%+1,s%)+8*neighbr%:(p%-1,cx%-1,cy%,s%)
  424.     IF uf%(root%)=0
  425.         capture%:(cx%,cy%,s%)
  426.         cap%=16
  427.     ENDIF
  428.     mv%(mn%)=cx%+256*cy%
  429.     clix%=clix%+1
  430.     log%(clix%)=cap%
  431.     curret:
  432. ENDP REM move
  433.  
  434. PROC neighbr%:(p%,x%,y%,s%)
  435.     LOCAL ns%,nr%
  436.     IF pt%(p%)=-1 :RETURN 0: ENDIF
  437.     ns%=bd%(p%)
  438.     IF ns%=0
  439.         ufset:(root%,uf%(root%)-1) REM add liberty
  440.         ko%(mn%+1)=-1
  441.         RETURN 0
  442.     ENDIF
  443.     nr%=p%
  444.     WHILE uf%(nr%)>0
  445.         nr%=uf%(nr%)
  446.     ENDWH
  447.     IF ns%=s%
  448.         IF nr%=root%
  449.             ufset:(nr%,uf%(nr%)+1)
  450.         ELSE
  451.             ns%=uf%(root%)+uf%(nr%)+1
  452.             IF uf%(root%) < uf%(nr%)
  453.                 ufset:(root%,ns%)
  454.                 ufset:(nr%,root%)
  455.             ELSE
  456.                 ufset:(nr%,ns%)
  457.                 ufset:(root%,nr%)
  458.                 root%=nr%
  459.             ENDIF
  460.         ENDIF
  461.         ko%(mn%+1)=-1
  462.         RETURN 0
  463.     ENDIF
  464.     IF uf%(nr%)=-1
  465.       IF capture%:(x%,y%,ns%)=1 AND ko%(mn%+1)=0
  466.           ko%(mn%+1)=p%
  467.       ELSE
  468.           ko%(mn%+1)=-1
  469.       ENDIF
  470.       RETURN 1
  471.     ENDIF
  472.     ufset:(nr%,uf%(nr%)+1)
  473.     RETURN 0
  474. ENDP REM neighbr
  475.  
  476. PROC ufset:(i%,v%)
  477.     clix%=clix%+2
  478.     log%(clix%)=i%
  479.     log%(clix%-1)=uf%(i%)
  480.     uf%(i%)=v%
  481. ENDP REM ufset
  482.  
  483. PROC back:
  484.     LOCAL p%,s%,i%
  485.     IF mn%=0 :BEEP 10,100 :RETURN :ENDIF
  486.     p%=mv%(mn%)
  487.     s%=2-(mn% AND 1)
  488.     mn%=mn%-1
  489.     IF p%=-1
  490.         GIPRINT "Pass"
  491.         RETURN
  492.     ENDIF
  493.     cx%=PEEKB(ADDR(mv%(mn%+1)))
  494.     cy%=PEEKB(ADDR(mv%(mn%+1))+1)
  495.     p%=pos%:(cx%,cy%)
  496.     mvcur:
  497.     i%=log%(clix%)
  498.     clix%=clix%-1
  499.     IF i%=16
  500.         fill:(cx%,cy%,s%)
  501.     ELSE
  502.         play:(cx%,cy%,s%)
  503.         IF i% AND 1 :fill:(cx%,cy%-1,3-s%) :ENDIF
  504.         IF i% AND 2 :fill:(cx%+1,cy%,3-s%) :ENDIF
  505.         IF i% AND 4 :fill:(cx%,cy%+1,3-s%) :ENDIF
  506.         IF i% AND 8 :fill:(cx%-1,cy%,3-s%) :ENDIF
  507.     ENDIF
  508.     DO
  509.         i%=log%(clix%)
  510.         IF i%<20 :BREAK :ENDIF
  511.         uf%(i%)=log%(clix%-1)
  512.         clix%=clix%-2
  513.     UNTIL 0
  514.     play:(cx%,cy%,0)
  515.     curret:
  516. ENDP REM back
  517.  
  518. PROC aHkE%:
  519.     IF forward%:
  520.         RETURN 0
  521.     ENDIF
  522.     RETURN 4
  523. ENDP
  524.  
  525. PROC forward%:
  526.     LOCAL p%,x%,y%
  527.     mn%=mn%+1
  528.     p%=mv%(mn%)
  529.     IF p%=-1
  530.         GIPRINT "Pass"
  531.     ELSE
  532.         x%=PEEKB(ADDR(mv%(mn%)))
  533.         y%=PEEKB(ADDR(mv%(mn%))+1)
  534.         p%=pos%:(x%,y%)
  535.         mn%=mn%-1
  536.         IF x%=0 OR x%>bw% OR y%=0 OR y%>bh%
  537.             BEEP 4,400
  538.             RETURN -1
  539.         ENDIF
  540.         IF bd%(p%) OR p%=ko%(mn%+1)
  541.             BEEP 7,100
  542.             RETURN -1
  543.         ENDIF
  544.         cx%=x% :cy%=y%
  545.         mvcur:
  546.         move:
  547.     ENDIF
  548.     RETURN 0
  549. ENDP REM forward
  550.  
  551. PROC fill:(x%,y%,s%)
  552.     LOCAL p%
  553.     p%=pos%:(x%,y%)
  554.     IF bd%(p%) OR pt%(p%)=-1 :RETURN :ENDIF
  555.     play:(x%,y%,s%)
  556.     fill:(x%,y%-1,s%)
  557.     fill:(x%+1,y%,s%)
  558.     fill:(x%,y%+1,s%)
  559.     fill:(x%-1,y%,s%)
  560. ENDP REM fill
  561.  
  562. PROC aHkR%:
  563.     capture%:(cx%,cy%,bd%(pos%:(cx%,cy%)))
  564.     curret:
  565.     RETURN 0
  566. ENDP REM delete
  567.  
  568. PROC capture%:(x%,y%,col%)
  569.     LOCAL p%,s%
  570.     p%=pos%:(x%,y%)
  571.     s%=bd%(p%)
  572.     IF s%=0 OR pt%(p%)=-1 :RETURN 0 :ENDIF
  573.     IF s%<>col%
  574.         WHILE uf%(p%)>0
  575.             p%=uf%(p%)
  576.         ENDWH
  577.         ufset:(p%,uf%(p%)-1)
  578.         RETURN 0
  579.     ENDIF
  580.     play:(x%,y%,0)
  581.     p%=1+capture%:(x%,y%-1,col%)+capture%:(x%+1,y%,col%)+capture%:(x%,y%+1,col%)+capture%:(x%-1,y%,col%)
  582.     RETURN p%
  583. ENDP REM capture
  584.  
  585. PROC aHkP%:
  586.     changed%=1
  587.     mn%=mn%+1
  588.     mv%(mn%)=-1
  589.     ko%(mn%+1)=0
  590.     GIPRINT "Pass"
  591.     RETURN 0
  592. ENDP REM pass
  593.  
  594. PROC aHkT%:
  595.     LOCAL maxnv&
  596.     maxnv&=maxnv%
  597.     dINIT "Scrolling"
  598.     dLONG maxnv&,"Edge visibility:",0,39
  599.     fLock:
  600.     DIALOG
  601.     fUnlock:
  602.     IF maxnv&<>maxnv%
  603.         maxnv%=maxnv&
  604.         vscroll:
  605.     ENDIF
  606.     RETURN 0
  607. ENDP REM scroll
  608.  
  609. PROC drawbrd:
  610.     LOCAL p%,dx%,y%,s%
  611.     gUPDATE OFF
  612.     gCLS
  613.     IF sr%=1
  614.         drawdots:
  615.     ELSE
  616.         drwlines:
  617.     ENDIF
  618.     y%=1
  619.     DO
  620.         dx%=0 :p%=pos%:(1,y%)
  621.         DO
  622.             s%=bd%(p%+dx%)
  623.             IF s% OR pt%(p%+dx%)=7
  624.                 play:(dx%+1,y%,s%)
  625.             ENDIF
  626.             dx%=dx%+1
  627.         UNTIL dx%=bw%
  628.     y%=y%+1
  629.     UNTIL y%>bh%
  630.     mvcur:
  631.     CURSOR gb%,0,3,3
  632.     gUPDATE ON
  633. ENDP REM drawbrd
  634.  
  635. PROC drawdots:
  636.     gPATT db%,bwp%,bhp%,3
  637. ENDP REM drawdots
  638.  
  639. PROC drwlines:
  640.     LOCAL i%
  641.     i%=sr%
  642.     DO
  643.         gAT i%,sr%
  644.         gLINEBY 0,bhp%-sd%+1
  645.     i%=i%+nd%
  646.     UNTIL i%>=bwp%
  647.     i%=sr%
  648.     DO
  649.         gAT sr%,i%
  650.         gLINEBY bwp%-sd%,0
  651.     i%=i%+nd%
  652.     UNTIL i%>=bhp%
  653. ENDP REM drwlines
  654.  
  655. PROC play:(x%,y%,s%)
  656.     LOCAL p%,t%
  657.     p%=pos%:(x%,y%)
  658.     bd%(p%)=s%
  659.     bat:(x%,y%)
  660.     t%=s%
  661.     IF t%=0
  662.         t%=pt%(p%)
  663.     ENDIF
  664.     gCOPY eb%,t%*sd%,0,sd%,sd%,3
  665. ENDP REM play
  666.  
  667. PROC aHkD%:
  668.     LOCAL bw&,bh&,neww%,newh%,oldsr%,ret%
  669.     bw&=bw%
  670.     bh&=bh%
  671.     oldsr%=sr%
  672.     dINIT "Dimensions"
  673.     dLONG bw&,"Board Width:",2,19
  674.     dLONG bh&,"Board Height:",2,19
  675.     dCHOICE sr%,"Stone Size:","3,5,7,9,11"
  676.     fLock:
  677.     ret%=DIALOG
  678.     fUnlock:
  679.     IF ret%=0 :RETURN 0 :ENDIF
  680.     neww%=bw& :newh%=bh&
  681.     IF oldsr%<>sr%
  682.         newstns:
  683.     ENDIF
  684.     IF neww%<>bw% OR newh%<>bh% OR bs%=0
  685.         resize:(neww%,newh%)
  686.     ELSE
  687.         newbrd:
  688.     ENDIF
  689.     RETURN 0
  690. ENDP REM board
  691.  
  692. PROC newstns:
  693.     LOCAL i%
  694.     sd%=2*sr%+1
  695.     nd%=sd%+1
  696.     IF eb% :gCLOSE(eb%) :ENDIF
  697.     eb%=gCREATEBIT(12*nd%,nd%)
  698.     gCLS
  699.     IF sr%=1
  700.         i%=1
  701.         DO
  702.             gAT i%,1 :gLINEBY 1,1
  703.             i%=i%+3
  704.         UNTIL i%>36
  705.         gAT 3,0 :gFILL 3,3,1 :gINVERT 3,3
  706.         gAT 6,0 :gFILL 3,3,2
  707.         RETURN
  708.     ENDIF
  709.     gAT sr%,0 :gLINEBY 0,sd%
  710.     gAT 0,sr% :gLINEBY sd%,0
  711.     gAT 3*sd%+sr%,sr% :gBOX sd%+nd%,sd%
  712.     gAT 4*sd%+sr%,sr% :gLINEBY 0,sd%
  713.     gAT 6*sd%+sr%,0 :gLINEBY 0,nd%
  714.     gAT 7*sd%+sr%,0 :gLINEBY 0,nd%
  715.     gAT 8*sd%+sr%,0 :gLINEBY 0,nd%
  716.     gAT 6*sd%+sr%,sr% :gLINEBY 2*sd%,0
  717.     gAT 9*sd%+sr%,-sr% :gBOX sd%+nd%,sd%
  718.     gAT 10*sd%+sr%,0 :gLINEBY 0,sr%
  719.     IF sr%=2
  720.         gAT 7*sd%+sr%,sr% :gFILL 1,1,1
  721.     ELSE
  722.         gAT 7*sd%+sr%-1,sr%-1 :gFILL 3,3,0
  723.     ENDIF
  724.     gAT sd%,0
  725.     IF sr%<4
  726.         gINVERT sd%,sd%
  727.     ELSE
  728.         gBORDER 0,sd%,sd%
  729.         gMOVE 1,1
  730.         gFILL sd%-2,sd%-2,0
  731.     ENDIF
  732.     gAT 2*sd%,0
  733.     IF sr%<4
  734.         gINVERT sd%,sd%
  735.         gMOVE 1,1
  736.         gFILL sd%-2,sd%-2,1
  737.     ELSE
  738.         gBORDER 0,sd%,sd%
  739.     ENDIF
  740. ENDP REM newstns
  741.  
  742. PROC border:(w%,h%,m%)
  743.     LOCAL i%,e%
  744.     i%=pos%:(1,h%)
  745.     pt%(i%)=6-3*m%
  746.     pt%(i%+21)=m% OR 6
  747.     e%=i%+w%-1
  748.     WHILE i%<e%
  749.         i%=i%+1
  750.         pt%(i%)=10 AND m%
  751.         pt%(i%+21)=-1 AND m%
  752.     ENDWH
  753.     i%=21+w%
  754.     pt%(i%)=(m% AND 5) OR 4
  755.     pt%(i%+1)=m% OR 4
  756.     WHILE i%<e%
  757.         i%=i%+21
  758.         pt%(i%)=8 AND m%
  759.         pt%(i%+1)=-1 AND m%
  760.     ENDWH
  761.     pt%(e%)=11 AND m%
  762. ENDP REM border
  763.  
  764. PROC resize:(w%,h%)
  765.     LOCAL bs9%,bs13%,bs19%
  766.     IF bw% :border:(bw%,bh%,0) :ENDIF
  767.     bw%=w% :bh%=h%
  768.     bs%=bw%*bh%
  769.     obwp%=4*bw%+1 :obhp%=4*bh%+1
  770.     IF ogb% :gCLOSE(ogb%) :ENDIF
  771.     ogb%=gCREATE(240-obwp%,0,obwp%,obhp%,1)
  772.     bs9%=(bw%=9) AND (bh%=9) AND 7
  773.     bs13%=(bs%=169) AND 7
  774.     bs19%=(bs%= 361) AND 7
  775.     pt%(pos%:( 3, 3))=bs9%
  776.     pt%(pos%:( 3, 7))=bs9%
  777.     pt%(pos%:( 7, 3))=bs9%
  778.     pt%(pos%:( 7, 7))=bs9% OR bs13%
  779.     pt%(pos%:( 4, 4))=bs13% OR bs19%
  780.     pt%(pos%:( 4,10))=bs13% OR bs19%
  781.     pt%(pos%:( 4,16))=bs19%
  782.     pt%(pos%:(10, 4))=bs13% OR bs19%
  783.     pt%(pos%:(10,10))=bs13% OR bs19%
  784.     pt%(pos%:(10,16))=bs19%
  785.     pt%(pos%:(16, 4))=bs13% OR bs19%
  786.     pt%(pos%:(16,10))=bs19%
  787.     pt%(pos%:(16,16))=bs13% OR bs19%
  788.     border:(bw%,bh%,-1)
  789.     IF bw%>=6 AND bh%>=6
  790.         cx%=4 :cy%=4
  791.     ELSE
  792.         cx%=1 :cy%=1
  793.     ENDIF
  794.     emptybrd:(0)
  795.     newbrd:
  796. ENDP REM resize
  797.  
  798. PROC newbrd:
  799.     bwp%=bw%*nd%-1
  800.     bhp%=bh%*nd%-1
  801.     IF gb%
  802.         gCLOSE(gb%)
  803.     ENDIF
  804.     gb%=gCREATE(0,0,bwp%,bhp%,1)
  805.     drawbrd:
  806. ENDP REM newbrd
  807.  
  808. PROC bat:(x%,y%)
  809.     gAT (x%-1)*nd%,(y%-1)*nd%
  810. ENDP REM bat
  811.  
  812. PROC curret:
  813.     gAT cx%*nd%-sr%-3,cy%*nd%-sr%-3
  814. ENDP REM curret
  815.  
  816. PROC mvcur:
  817.     curret:
  818.     vscroll:
  819. ENDP REM mvcur
  820.  
  821. PROC vscroll:
  822.     LOCAL nv%
  823.     nv%=gY-39
  824.     IF bhp%<=80 :RETURN :ENDIF
  825.     IF nv%<=maxnv%
  826.         gSETWIN 0,0
  827.     ELSEIF bhp%-80-nv%<=maxnv%
  828.         gSETWIN 0,80-bhp%
  829.     ELSE
  830.         gSETWIN 0,-nv%
  831.     ENDIF
  832. ENDP REM vscroll
  833.  
  834. PROC pos%:(x%,y%)
  835.     RETURN x%+21*y%
  836. ENDP REM pos%
  837.